home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Module source / TEFwindMod.txt < prev    next >
Encoding:
Text File  |  1995-11-27  |  8.1 KB  |  325 lines  |  [TEXT/MSET]
  1. \ 15May93 DBH  Change echovec per mrh.  Separate TEScroller and TEwind code
  2.     \ into different files.  Implement lineEnd: method in intepret:
  3. \ 14May93 DBH Dropped new: and test: methods.
  4.     \ Added enable: and disable: methods 
  5.     \ Reworked interpret: to eliminate local variables.
  6.     \ Made theTEScroller an ivar.  Lock: and unlock: buffer in interpret:
  7. \ 11May93 DBH  NewEventLoop -> quitvec.
  8.     \ Handle tabs as 4 spaces.  Make code independent of QEinit file.
  9. \ 19May93    mrh    Made theTEscroller a subview.  Added theStack.
  10. \ Sept93    mrh    revised for new controls scheme.
  11. \ Mar94        mrh adapted for TWstr (buffer for output to TW).  Added INITFONT
  12. \                to DS: in StackView.
  13.  
  14. need    TEScroller
  15. \ need    alert
  16.  
  17. TEscroller    theTEscroller
  18.  
  19.  
  20. : TESizeCheck  ( n -- )        \ The 2.4 alert was too much of a pest.  Now
  21.     32000 >                    \ we just quietly delete some text from the
  22.                             \ front.
  23.     IF
  24.         0  2000  setSelect: theTEscroller
  25.         clear: theTEscroller
  26.         32000 dup setSelect: theTEscroller
  27.     THEN  ;
  28.  
  29.  
  30. \ support for interpretation
  31.  
  32. : skip_line
  33.     13 chsearch: QEstr
  34.     negate more: QEstr
  35.     delete: QEstr  nolim: QEstr ;
  36.  
  37. : skip1
  38.     1 skip: QEstr ;
  39.  
  40.  
  41. : BL->CR/TB  { \ notparms -- }
  42.     true -> notparms
  43.     reset: QEstr
  44.     BEGIN
  45.         len: QEstr
  46.     WHILE
  47.         1st: QEstr
  48.         CASE[ & \ ]=>  notparms dup drop IF skip_line ELSE skip1 THEN
  49.             [ & { ]=>  false -> notparms skip1    \ do not allow skip_line after a '{' until '}'
  50.             [ & } ]=>  true  -> notparms skip1    \ ok to allow skip_line after a '}'
  51.             [ 0 31 RANGE]=> 32 chovwr: QEstr
  52.             DEFAULT=> drop skip1
  53.         ]CASE
  54.     REPEAT
  55.     reset: QEstr ;
  56.  
  57.  
  58.  
  59. \ StackView is a view which just displays the top few stack cells.
  60. \ A possible problem is that at the time of call, Mops may have a
  61. \ variable number of its own quantities on the stack, depending on the
  62. \ circumstances of the call.  We avoid this by defining the standard
  63. \ DRAW: method to do nothing, and actually do the drawing at regular
  64. \ intervals on an idle event, which generally has the same number of
  65. \ Mops' quantities on the stack (currently 2).  We do a few tricks to
  66. \ avoid unnecessary drawing so the view doesn't flicker too much.  We
  67. \ only draw if the depth has changed since the last idle, or if the
  68. \ value drawStack? has been set true, which happens when we interpret
  69. \ something (and we set it back false ready for next time).
  70.  
  71.     0    value    lastDepth
  72.     0    value    idleCnt
  73. false    value    drawStack?
  74.  
  75.  
  76.  
  77. : EvalFromQE  { \ x1 -- x1 }
  78.         \ Evaluates contents of QEstr.  If we're using
  79.         \ fWind, there's an extra item on the stack
  80.         \ that we have to save - don't ask me what it is!!!
  81.     
  82. \    fWind? IF -> x1  THEN
  83.     BL->CR/TB
  84.     true -> drawStack?            \ Set stack display to draw on next idle
  85.     lock: QEstr
  86.     get: QEstr  evaluate
  87.     unlock: QEstr
  88.     prompt? fWind? or IF  ok  THEN
  89.     prompt? IF  cr  THEN        \ prompt & cr if required
  90. \    fWind? IF  x1  THEN  ;
  91. ;
  92.  
  93. : .S+
  94.     -curs
  95.     ." Stack:  "
  96.     depth 0<= IF  ." empty"  EXIT  THEN
  97.     ." depth "  depth .  cr
  98.     sp@ depth 1- FOR  dup .cell cr  4+  NEXT  drop  ;
  99.  
  100.  
  101.  
  102. :class  STACKVIEW  super{ view }
  103.  
  104. :m DS:  { \ svPort -- }        \ Does the main work for DRAWSTACK:.
  105.  
  106. \ First, if it's time to draw the stack, we make sure we've flushed
  107. \ any pending output in the main view.
  108.  
  109.     flush_TWstr
  110.  
  111. \ Now let's draw that stack...
  112.  
  113.     pushPort -> svPort                \ Port could be anything, so we have to
  114.     get: ^myWind  set: window        \  save and restore
  115.     initFont                        \ Ensure font is right
  116.     depth -> lastDepth
  117.     oldVecs
  118.     get: viewRect  swap 15 - swap  put: tempRect
  119.     draw: tempRect                    \ Draw a frame
  120.     1 1 inset: tempRect
  121.     addr: tempRect call ClipRect
  122.     clear: tempRect
  123.     10 10 gotoxy  .s+  newVecs
  124.     noClip                            \ Easier than saving and restoring!
  125.     svPort  popPort  ;m
  126.  
  127. :m DRAW:    true -> drawStack?  ;m
  128.  
  129. :m DRAWSTACK:  { x1 -- x1 } \ 30Apr94 DBH, one less stack item to manage.
  130.     clrStk? 
  131.     IF            \ We've been told to clear the stack, so we do it,
  132.                 \  draw it, then get out.
  133.         sp0 sp!  ds: self
  134.         false -> clrStk?
  135.         x1  EXIT
  136.     THEN
  137.     idleCnt    NIF  5 -> idleCnt  ELSE 1 --> idleCnt  THEN
  138.     depth  lastDepth <>  idleCnt 0= and    \ draw if it's time and depth is difft
  139.     drawStack?  or  false -> drawStack?    \ but if we're told, we draw anyway
  140.     NIF  x1  EXIT  THEN
  141.     ds: self
  142.     x1 ;m
  143.  
  144. :m IDLE:    drawStack: self  ;m
  145.  
  146. :m CLASSINIT:
  147.     parLeft parTop parRight parTop  setJust: self
  148.     0 0 0 100  setBounds: self  ;m
  149.     
  150. ;class
  151.  
  152.  
  153. stackView    theStack
  154.  
  155. :class    TEFview  super{ view }        \ For the TEFwind ContView
  156.  
  157. :m CLASSINIT:
  158.     classinit: super
  159.     parLeft parTop parRight parBottom  setJust: theTEscroller
  160.     0 102 0 0  setBounds: theTEscroller  ;m
  161.  
  162. ;class
  163.  
  164.  
  165. TEFview        TFV            \ This will be the ContView
  166.  
  167.  
  168. \ ============= Here's the main TEFwind class ===================
  169.  
  170. :class  TEFwind  super{ window+ }
  171.  
  172.     handle    BUFFER        \ merely a place to manipulate the TEscrap handle
  173.  
  174. :m CUT:
  175.     cut: theTEscroller
  176.     fixPanRect: theTEscroller
  177.     caretIntoView: theTEscroller  ;m
  178.  
  179. :m COPY:
  180.     copy: theTEscroller  ;m
  181.  
  182. :m PASTE:
  183.     global TEScrpHandle @  put: buffer  size: buffer
  184.     size: theTEScroller +  TESizeCheck
  185.     paste: theTEscroller
  186.     fixPanRect: theTEscroller
  187.     caretIntoView: theTEscroller  ;m
  188.  
  189. :m CLEAR:
  190.     clear: theTEscroller
  191.     fixPanRect: theTEscroller
  192.     caretIntoView: theTEscroller  ;m
  193.  
  194. :m SelAll:
  195.     0 32767 setSelect: theTEscroller  ;m
  196.  
  197.  
  198. :m INSERT: { addr len -- }
  199.     size: theTEscroller  len +  TESizeCheck
  200.     addr len  insert: theTEscroller  ;m
  201.  
  202.  
  203. :m INTERPRET:  { \ echoCR? -- }
  204.     selEnd: theTEscroller  selStart: theTEscroller =
  205.     IF                                    \ nothing selected
  206.         getLine: theTEscroller  ( addr len )  put: QEstr
  207.         true -> echoCR?
  208.     ELSE                                \ we have a hilited selection
  209.         handle: theTEscroller  call TECopy
  210.         global TEScrpHandle @ put: buffer
  211.         lock: buffer
  212.         ptr: buffer  size: buffer  ( addr len )  put: QEstr
  213.         unlock: buffer
  214.         false -> echoCR?
  215.     THEN
  216.     lineEnd: theTEscroller dup setselect: theTEscroller
  217.     echoCR? IF  cr  THEN
  218.     evalFromQE  flush_TWstr
  219. ;m
  220.  
  221.  
  222. :m KEY:        \ ( char -- )
  223.  
  224.     CASE[ 3 ( enter )    ]=>    interpret: self
  225.         [ 8 ( delete )    ]=> 8 key: theTEscroller    \ delete
  226.         [ 9 ( tab )        ]=>    4 spaces
  227.  
  228.         DEFAULT=>    size: theTEscroller 1+ TESizeCheck
  229.                      key: theTEscroller
  230.     ]CASE
  231. ;m
  232.  
  233. :m ENABLE:    enable: super    newVecs  ;m    
  234. :m DISABLE:    disable: super  ;m
  235.  
  236. :m DRAW:    { \ x1 x2 x3 x4 -- }
  237.     -> x4 -> x3 -> x2 -> x1
  238.     clrStk? IF  sp0 sp!  false -> clrStk?  THEN
  239.     ds: theStack
  240.     x1 x2 x3 x4
  241.     (draw): super  ;m
  242.  
  243. :m TextHandle:    textHandle: theTEscroller  ;m
  244.  
  245.  
  246. :m DUMP:
  247.     dump: theTEscroller ;m
  248.  
  249. ;class
  250.  
  251.                 
  252. handle    tmpHndl
  253. file    WorksheetFile
  254.  
  255. 0    value    ^TW
  256.  
  257. : SAVEWORKSHEET
  258.     " Worksheet"  name: worksheetFile
  259.     'type TEXT  'type MSET  set: worksheetfile
  260.     create: worksheetFile  ?EXIT            \ If we're on a network, this
  261.                                             \ may fail, so we just get out.
  262.     textHandle: [ ^TW ]  put: tmpHndl  lock: tmpHndl
  263.     ptr: tmpHndl  size: tmpHndl  write: worksheetFile  drop
  264.     release: tmpHndl
  265.     close: worksheetFile  drop  ;
  266.  
  267.  
  268. : GETWORKSHEET    { \ adr n -- }
  269.     " Worksheet"  name: worksheetFile
  270.     open: worksheetFile
  271.     IF  .room  EXIT  THEN            \ If it doesn't exist, we'll start a
  272.                                     \ new one with a .room display, and out.
  273.     size: worksheetFile  -> n
  274.     n  new: tmpHndl  lock: tmpHndl
  275.     ptr: tmpHndl  -> adr
  276.     adr n  read: worksheetFile
  277.     dup -39 =  if  drop  0  then  OK?        \ We don't worry if the error
  278.                                             \  was endfile
  279.     bytesRead: worksheetFile  -> n
  280.     close: worksheetFile  drop
  281.     adr n insert: [ ^TW ]
  282.     release: tmpHndl  ;
  283.  
  284.  
  285. : DO_RUN_TE  { TW-addr \ ^view left top rt bot sRt sBot -- }
  286.     -curs  -echo
  287.     TW-addr -> ^TW
  288.     deep_classinit: [ ^TW ]
  289. \    fWind? IF  close: fWind  THEN        \ say goodbye to Mr. fwind
  290.  
  291.     theStack addView: TFV  theTEscroller addView: TFV
  292.     pause pause pause                    \ Get us to the front under sys 6
  293.                                         \  or the system clobbers scroll bars
  294.     20 -> left  50 -> top
  295.     520 -> rt  360 -> bot
  296.     screenbits  -> sBot  -> sRt  2drop
  297.     rt sRt min  -> rt
  298.     bot sBot min  -> bot
  299.     left top rt bot  put: tempRect
  300.     screenbits true setGrow: [ ^TW ]
  301.     screenbits true setDrag: [ ^TW ]
  302.     true  setZoom: [ ^TW ]
  303.     tempRect  myDoc  docWind  true false  TFV  new: [ ^TW ]
  304.     newvecs
  305.     true -> emit?                \ EMIT is now safe since we have a window
  306. \    true -> relocChk?
  307.     xts{  xUndo null xCut xCopy xPaste xClear xSelAll null doPref }
  308.                                                         3  init: EditMen
  309.     getworksheet
  310.     false -> fWindActive?        \ Mustn't forget this!!
  311.     eventLoop
  312. ;
  313.  
  314. : BYE+        saveWorksheet  bye  ;
  315.  
  316. : xCut        cut:  [ ^TW ]  ;
  317. : xCopy        copy: [ ^TW ]  ;
  318. : xPaste    paste: [ ^TW ]  ;
  319. : xClear    clear: [ ^TW ]  ;
  320. : xUndo        nimpl  ;
  321. : xSelAll    selAll: [ ^TW ]  ;
  322.  
  323.  
  324. endload
  325.